Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue40/COMCorn/ViewObj.pas

Pascal/Delphi Source File | 1998-11-11 | 8.3 KB | 268 lines

unit ViewObj;

interface
uses Windows, ActiveX, ComObj, ShlObj, CommCtrl, Main, UtilObjs, ExtForm;

type
  // IShellView implementation for namespace extension.  Note that this must be
  // a separate, stand-alone class because multiple IShellViews can be requested
  // from a single IShellFolder.
  TViewObject = class(TMultiAggregatedObject, IShellView)
  private
    FControlExt: TComNameExt;
    FOwner: HWND;
    FShellBrowser: IShellBrowser;
    FViewForm: TMainForm;
    FFolderSettings: TFolderSettings;
  protected
    { IOleWindow methods }
    function GetWindow(out wnd: HWND): HResult; stdcall;
    function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
    { IShellView methods }
    function TranslateAccelerator(var Msg: TMsg): HResult; stdcall;
    function EnableModeless(Enable: Boolean): HResult; stdcall;
    function UIActivate(State: UINT): HResult; stdcall;
    function Refresh: HResult; stdcall;
    function CreateViewWindow(PrevView: IShellView;
      var FolderSettings: TFolderSettings; ShellBrowser: IShellBrowser;
      var Rect: TRect; out Wnd: HWND): HResult; stdcall;
    function DestroyViewWindow: HResult; stdcall;
    function GetCurrentInfo(out FolderSettings: TFolderSettings): HResult; stdcall;
    function AddPropertySheetPages(Reseved: DWORD;
      lpfnAddPage: TFNAddPropSheetPage; lParam: LPARAM): HResult; stdcall;
    function SaveViewState: HResult; stdcall;
    function SelectItem(pidl: PItemIDList; flags: UINT): HResult; stdcall;
    function GetItemObject(Item: UINT; const iid: TIID; IPtr: Pointer): HResult; stdcall;
  public
    constructor Create(Controller: TComNameExt; Owner: HWND); reintroduce;
    procedure ContextMenu;
    property ControlExt: TComNameExt read FControlExt;
  end;

implementation

uses SysUtils, ComCtrls, ShellAPI, Graphics, Menus, Controls;

{ TViewObject }

constructor TViewObject.Create(Controller: TComNameExt; Owner: HWND);
begin
  inherited Create(Controller);
  FControlExt := Controller;
  FOwner := Owner;
end;

{ TViewObject.IOleWindow }

function TViewObject.GetWindow(out wnd: HWnd): HResult;
begin
  Result := E_NOTIMPL;
end;

function TViewObject.ContextSensitiveHelp(fEnterMode: BOOL): HResult;
begin
  Result := E_NOTIMPL;
end;

{ TViewObject.IShellView }

function TViewObject.TranslateAccelerator(var Msg: TMsg): HResult;
begin
  Result := S_FALSE;
end;

function TViewObject.EnableModeless(Enable: Boolean): HResult;
begin
  Result := E_NOTIMPL;
end;

function TViewObject.UIActivate(State: UINT): HResult;
begin
  // !!
  Result := S_OK;
end;

function TViewObject.Refresh: HResult;
var
  EnumObj: IEnumIDList;
  Folder: IShellFolder;
  IconOMatic: IExtractIcon;
  Fetched: ULONG;
  ItemID: array[1..100] of PItemIDList;
  Str: TStrRet;
  ListItem: TListItem;
  I, IconIndex: Integer;
  IconIdx: Word;
  IconFile: array[0..MAX_PATH] of char;
  Icon: HICON;
begin
  Result := S_OK;
  try
    // Get latest info from registry
    FControlExt.RefreshServerList;
    // Clear UI and any previously allocated pidls
    FViewForm.ListView.Items.BeginUpdate;
    try
      with FViewForm.ListView do
      begin
        for I := 0 to Items.Count - 1 do
          if Items[I].Data <> nil then
            FControlExt.ShellMalloc.Free(Items[I].Data);
        Items.Clear;
      end;
      FViewForm.ImageList.Clear;
      // Get IEnumIDList interface from my shell folder
      Folder := FControlExt as IShellFolder;
      Folder.EnumObjects(FOwner, SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or
        SHCONTF_INCLUDEHIDDEN, EnumObj);
      // Enumerate all objects in my namespace, fetching 100 at a time
      // in order to speed things up a little.
      while EnumObj.Next(100, ItemID[1], Fetched) = S_OK do
        for I := 1 to Fetched do
        begin
          // Add a new item to my listview
          ListItem := FViewForm.ListView.Items.Add;
          ListItem.Data := ItemID[I];
          // Get the display name for the pidl
          OleCheck(Folder.GetDisplayNameOf(ItemID[I], 0, Str));
          case Str.uType of
            STRRET_WSTR:
              begin
                ListItem.Caption := WideCharToString(Str.pOleStr);
                FControlExt.ShellMalloc.Free(Str.pOleStr);
              end;
            STRRET_CSTR: ListItem.Caption := Str.cStr;
          end;
          // Get the IExtractIcon UI object for this pidl
          if Folder.GetUIObjectOf(FOwner, 1, ItemID[I], IExtractIcon, nil,
            Pointer(IconOMatic)) = S_OK then
          begin
            IconOMatic.GetIconLocation(GIL_FORSHELL, IconFile, SizeOf(IconFile),
              IconIndex, Fetched);
            if Fetched and GIL_NOTFILENAME = 0 then
            begin
              // Get Icon file, and add it to imagelist
              IconIdx := IconIndex;
              Icon := ExtractAssociatedIcon(MainInstance, IconFile, IconIdx);
              if Icon <> 0 then
                ListItem.ImageIndex := ImageList_AddIcon(FViewForm.ImageList.Handle,
                  Icon);
            end;
          end;
        end;
    finally
      FViewForm.ListView.Items.EndUpdate;
    end;
  except
    on E: TObject do
      Result := Controller.SafeCallException(E, ExceptAddr);
  end;
end;

function TViewObject.CreateViewWindow(PrevView: IShellView;
  var FolderSettings: TFolderSettings; ShellBrowser: IShellBrowser;
  var Rect: TRect; out Wnd: HWND): HResult;
var
  MainWindow: HWND;
begin
  Result := S_OK;
  try
    FFolderSettings := FolderSettings;    // Save away folder settings
    FShellBrowser := ShellBrowser;        // Save away shell's IShellBrowser
    FShellBrowser.GetWindow(MainWindow);  // Get parent window for my window
    FViewForm := TMainForm.Create(nil);   // Create my browser window
    FViewForm.ShellView := Self;
    FViewForm.ParentWindow := MainWindow; // Set parent and bounds
    FViewForm.BoundsRect := Rect;
    Refresh;                              // Rebuild list view
    FViewForm.Show;                       // Show my window
    Wnd := FViewForm.Handle;              // Return my window's handle
  except
    on E: TObject do
      Result := Controller.SafeCallException(E, ExceptAddr);
  end;
end;

function TViewObject.DestroyViewWindow: HResult;
begin
  Result := S_OK;
  try
    FViewForm.Release;
    FViewForm := nil;
  except
    on E: TObject do
      Result := Controller.SafeCallException(E, ExceptAddr);
  end;
end;

function TViewObject.GetCurrentInfo(out FolderSettings: TFolderSettings): HResult;
begin
  Result := S_OK;
  FolderSettings := FFolderSettings;
end;

function TViewObject.AddPropertySheetPages(Reseved: DWORD;
  lpfnAddPage: TFNAddPropSheetPage; lParam: LPARAM): HResult;
begin
  Result := E_NOTIMPL;
end;

function TViewObject.SaveViewState: HResult;
begin
  // !!
  Result := S_OK;
end;

function TViewObject.SelectItem(pidl: PItemIDList; flags: UINT): HResult;
begin
  Result := E_NOTIMPL;
end;

function TViewObject.GetItemObject(Item: UINT; const iid: TIID; IPtr: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;

const
  CmdFirst = FCIDM_SHVIEWFIRST + $1000;
  CmdLast = FCIDM_SHVIEWFIRST + $2000;

procedure TViewObject.ContextMenu;
var
  Popup: HMENU;
  ContextMenu: IContextMenu;
  Selected: TListItem;
  pidl: PItemIDList;
  Choice: Word;
  CmdInfo: TCMInvokeCommandInfo;
begin
  Selected := FViewForm.ListView.Selected;
  if Selected <> nil then
  begin
    pidl := Selected.Data;
    if (pidl <> nil) and ((FControlExt as IShellFolder).GetUIObjectOf(FOwner,
      1, pidl, IContextMenu, nil, Pointer(ContextMenu)) = S_OK) then
    begin
      Popup := CreatePopupMenu;
      ContextMenu.QueryContextMenu(Popup, 0, CmdFirst, CmdLast,
        CMF_NORMAL);
      Choice := LoWord(TrackPopupMenu(Popup, TPM_LEFTALIGN or TPM_TOPALIGN or
        TPM_RETURNCMD or TPM_RIGHTBUTTON, Mouse.CursorPos.X, Mouse.CursorPos.Y,
        0, FViewForm.ListView.Handle, nil));
      if Choice <> 0 then
      begin
        FillChar(CmdInfo, SizeOf(CmdInfo), 0);
        with CmdInfo do
        begin
          cbSize := SizeOf(CmdInfo);
          hwnd := FViewForm.ListView.Handle;
          lpVerb := PChar(MakeLong(Choice, 0));
        end;
        ContextMenu.InvokeCommand(CmdInfo);
      end;
    end;
  end;
end;

end.